HPAVC/HPAVC CD-ROM.iso/pc/PINBSRC.ZIP/_NORMVGA.PAS

Pascal/Delphi Source File | 1996-02-02 | 6.8 KB | 332 lines

{ 320x200 _NORMVGA - (c) Ansgar Scherp, Joachim Gelhaus
      all rights reserved / vt'95 }
var
  pal:array[0..255,1..3] of byte;

procedure video_mode(mode:byte);
begin
      asm
        mov  AH,00
        mov  AL,mode
        int  10h
      end;
end;

procedure flip(src,dst:word); assembler; asm { copy virt scr to visual scr }
  push ds; mov es,[dst]; mov ds,[src]; mov si,1
  mov di,1; mov cx,32000; rep movsw; pop ds;
end;

procedure set_rgb_color(color,red,green,blue:byte);
begin
    port[$3c8]:=color;
    port[$3c9]:=red;
    port[$3c9]:=green;
    port[$3c9]:=blue;
end;

procedure get_rgb_color(color,red,green,blue:byte);
begin
    port[$3c8]:=color;
    red:=port[$3c9];
    green:=port[$3c9];
    blue:=port[$3c9];
end;

procedure retrace; assembler; asm
  mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  @vert2: in al,dx; test al,8; jnz @vert2; end;

procedure cls(lvseg:word); assembler;
asm
  mov es,[lvseg]
  xor di,di
  xor ax,ax
  mov cx,320*200/2
  rep stosw
end;


procedure palette_black;
var x:byte;
begin
  for x:=0 to 255 do set_RGB_COLOR(x,0,0,0);
end;

procedure put_pixel(x,y:word; color:byte);
begin
     if (x>0) and (x<320) then mem[$A000:(320*y)+x]:=color;
end;

function get_pixel(x,y:word):byte;
begin
     if (x>0) and (x<320) then get_pixel:=mem[$A000:(320*y)+x];
end;

procedure load_palette(fname:string);
var palfile:file of byte;
    i,j:integer;
    mfm:word;
begin
  mfm:=filemode;
  filemode:=0;
  if Pos('.',fname)=0 then fname:=fname+'.pal';
  assign(palfile,fname);
  {$I-}
  reset(palfile);
  {$I+}
  for i:=0 to 255 do
  begin
    for j:=1 to 3 do
    begin
      read(palfile,pal[i,j]);
    end;
  end;
  close(palfile);
  filemode:=mfm;
  port[$3c8]:=0;
  {kleine eigenmächtige manipulation}
  port[$3c9]:=0;port[$3c9]:=0;port[$3c9]:=0;
  for i:=1{0} to 255 do
  begin
    port[$3c9]:=pal[i,1];
    port[$3c9]:=pal[i,2];
    port[$3c9]:=pal[i,3];
  end;
end;

procedure load_mini_palette(fname:string);
var palfile:file of byte;
    j:integer;
    mfm:word;
    colnr:byte;
    b:byte;
begin
  mfm:=filemode;
  filemode:=0;
  if Pos('.',fname)=0 then fname:=fname+'.mpa';
  assign(palfile,fname);
  {$I-}
  reset(palfile);
  {$I+}
  repeat
    if not eof(palfile) then read(palfile,colnr);
    port[$3c8]:=colnr;
    for j:=1 to 3 do
    begin
      if not eof(palfile) then begin
        read(palfile,b);
        port[$3c9]:=b;
      end;
    end;
  until eof(palfile);
  close(palfile);
  filemode:=mfm;
end;

procedure load_palette_only(fname:string);
var palfile:file of byte;
    i,j:integer;
    mfm:word;
begin
  mfm:=filemode;
  filemode:=0;
  if Pos('.',fname)=0 then fname:=fname+'.pal';
  assign(palfile,fname);
  {$I-}
  reset(palfile);
  {$I+}
  for i:=0 to 255 do
  begin
    for j:=1 to 3 do
    begin
      read(palfile,pal[i,j]);
    end;
  end;
  close(palfile);
  filemode:=mfm;
end;

procedure load_mini_palette_only(fname:string);
var palfile:file of byte;
    i,j:integer;
    mfm:word;
    colnr:byte;
begin
  mfm:=filemode;
  filemode:=0;
  if Pos('.',fname)=0 then fname:=fname+'.mpa';

  assign(palfile,fname);
  {$I-}
  reset(palfile);
  {$I+}
  repeat
    if not eof(palfile) then read(palfile,colnr);
    for j:=1 to 3 do
    begin
      if not eof(palfile) then read(palfile,pal[colnr,j]);
    end;
  until eof(palfile);
  close(palfile);
  filemode:=mfm;
end;

procedure LOAD_VGA(fname:string);
var f:file;
    mfm:word;
begin
  mfm:=filemode;
  filemode:=0;
  assign(f,fname+'.VGA');
  reset(f,1);
  blockread(f,ptr($a000,0)^,64000);
  close(f);
  filemode:=mfm;
end;

procedure PutSprite(x,y,h,b:word;spriteseg:word);
var hoehe,breite:word;
var spriteofs:word;
    breitew:word;
    scrofs:word;
    scrseg:word;
begin
  breite:=b;
  breitew:=b div 2;
  spriteofs:=0;
  scrseg:=$a000;
  for hoehe:=y to y+h do
  begin
    scrofs:=hoehe*320+x;
    asm
      push ds;
      mov es,scrseg;     {ES:DI}
      mov ds,spriteseg; {DS:SI}
      mov si,spriteofs;
      mov di,scrofs;
      mov cx,breitew;
      rep movsw;
      pop ds;
    end;
    inc(spriteofs,breite);
  end;
end;

procedure Scroll(x,y,x1,y1,h,b:word);
var hoehe,breite:word;
var spriteofs:word;
    spriteseg:word;
    breitew:word;
    scrofs:word;
    scrseg:word;
begin
  breite:=b;
  breitew:=b div 2;
  spriteofs:=0;
  scrseg:=$a000;
  spriteseg:=$a000;
  for hoehe:=y1 to y1+h do
  begin
    spriteofs:=hoehe*320+x1;
    scrofs:=y*320+x;
    asm
      push ds;
      mov es,scrseg;     {ES:DI}
      mov ds,spriteseg; {DS:SI}
      mov si,spriteofs;
      mov di,scrofs;
      mov cx,breitew;
      rep movsw;
      pop ds;
    end;
    inc(y,1);
  end;
end;

procedure Palette_fade_in(fade_speed:byte);
var r,g,b,i,c,p:byte;
    pal_fade:array[0..255,1..3] of byte;
    u:integer;
begin
  for i:=0 to 100 do
  begin
    for c:=0 to 255 do
    begin
      r:=trunc(pal[c,1] / 100 * i);
      g:=trunc(pal[c,2] / 100 * i);
      b:=trunc(pal[c,3] / 100 * i);
      pal_fade[c,1]:=r;
      pal_fade[c,2]:=g;
      pal_fade[c,3]:=b;
    end;
    port[$3c8]:=0;
    for p:=0 to 255 do
    begin
      port[$3c9]:=pal_fade[p,1];
      port[$3c9]:=pal_fade[p,2];
      port[$3c9]:=pal_fade[p,3];
    end;
    if i<99 then inc(i);
    for p:=1 to fade_speed do retrace;
  end;
end;

procedure Palette_fade_out(fade_speed:byte;blackorwhite:byte);
var r,g,b,i,c,p:byte;
    pal_fade:array[0..255,1..3] of byte;
begin
  if blackorwhite=1 then begin
    for i:=1 to 63 do begin
      for c:=0 to 255 do begin
        r:=pal[c,1];
        g:=pal[c,2];
        b:=pal[c,3];
        if r<63 then inc(r);
        if g<63 then inc(g);
        if b<63 then inc(b);
        pal[c,1]:=r;
        pal[c,2]:=g;
        pal[c,3]:=b;
      end;
      port[$3c8]:=0;
      for p:=0 to 255 do begin
        port[$3c9]:=pal[p,1];
        port[$3c9]:=pal[p,2];
        port[$3c9]:=pal[p,3];
      end;
      for p:=1 to fade_speed do retrace;
    end;
  end else begin
    for i:=100 downto 0 do begin
      for c:=0 to 255 do begin
        r:=trunc(pal[c,1] / 100 * i);
        g:=trunc(pal[c,2] / 100 * i);
        b:=trunc(pal[c,3] / 100 * i);
        pal_fade[c,1]:=r;
        pal_fade[c,2]:=g;
        pal_fade[c,3]:=b;
      end;
      if i>1 then dec(i);
      for p:=1 to fade_speed do retrace;
      port[$3c8]:=0;
      for p:=0 to 255 do begin
        port[$3c9]:=pal_fade[p,1];
        port[$3c9]:=pal_fade[p,2];
        port[$3c9]:=pal_fade[p,3];
      end;
    end;
  end;
end;

procedure palette_refresh;
var c:byte;
begin
  for c:=0 to 255 do begin
    port[$3c8]:=c;
    pal[c,1]:=port[$3c9];
    pal[c,2]:=port[$3c9];
    pal[c,3]:=port[$3c9];
  end;
end;